home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / CO39 / WFPLUS.PAS < prev   
Pascal/Delphi Source File  |  1992-08-10  |  5KB  |  187 lines
  1. {WFPLUS - Function Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WFPlus;
  3. {************************  Interface       **********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects;
  6. const
  7.   sr_Recessed     =   1;
  8.   sr_Raised       =   0;
  9. function Max(I,J:Integer):Integer;
  10. function Min(I,J:Integer):Integer;
  11. function GetDateTime(szDateTime:PChar):Boolean;
  12. function ExpandTabs(InStr,OutStr:PChar;Tabsize:Integer):Boolean;
  13. function CheckCC(InStr,OutStr:PChar):Boolean;
  14. function SRectangle(PaintDC,X1,Y1,X2,Y2,LineWidth,State:Integer):Boolean;
  15. {************************  Implementation  ***************************}
  16. implementation
  17. {*************************  Max           ****************************}
  18. function Max(I,J:Integer):Integer;
  19. begin
  20.   if I < J then
  21.     Max := J
  22.   else
  23.     Max := I;
  24. end;
  25.  
  26. {************************  Min            ****************************}
  27. function Min(I,J:Integer):Integer;
  28. begin
  29.   if I < J then
  30.     Min := I
  31.   else
  32.     Min := J;
  33. end;
  34.  
  35. function  GetDateTime(szDateTime:PChar):Boolean;
  36. var
  37.   m,d,y,dw: Word;
  38.   temp,tag: string[4];
  39.   tStr: String;
  40. Begin
  41.   tStr := '';
  42.   GetTime(y,m,d,dw);
  43.   if (y > 12) then begin
  44.     y := (y - 12);
  45.     tag := 'pm';
  46.   End else
  47.     tag := 'am';
  48.   str(y,temp);
  49.   if (y < 10) then
  50.     temp := '0' + Temp;
  51.   tStr := tStr + temp + ':';
  52.   str(m,Temp);
  53.   tStr := tStr + temp + ':';
  54.   str(d,temp);
  55.   tStr := tStr + temp + tag + '     ';
  56.   GetDate(y,m,d,dw);
  57.   str(m,Temp);
  58.   if (m < 10) then
  59.     temp := '0' + temp;
  60.   tStr := tStr + temp + '/';
  61.   str(d,Temp);
  62.   if (d < 10) then
  63.     Temp := '0' + temp;
  64.   tStr := tStr + Temp + '/';
  65.   str(y,temp);
  66.   tStr := tStr + temp;
  67.   strPcopy(szDateTime,tStr);
  68.   GetDateTime := True;
  69. End;
  70.  
  71. function ExpandTabs(InStr,OutStr:PChar;Tabsize:Integer):Boolean;
  72. var
  73.   IndxIn,IndxOut,IndxTab:Integer;
  74.   NextTab:Integer;
  75.   Limit:Integer;
  76. begin
  77.   IndxIn := 0;IndxOut:= 0;IndxTab:= 0;
  78.   If InStr <> nil then
  79.       Limit := Max(StrLen(Instr)-1,0)
  80.   else
  81.       Limit := 0;
  82.   For IndxIn := 0 to Limit do
  83.     case InStr[IndxIn] of
  84.       #9:
  85.         begin
  86.         NextTab := ((IndxOut div TabSize) +1) * TabSize;
  87.         for IndxTab := 1 to (NextTab - IndxOut) do
  88.           begin
  89.           OutStr[IndxOut] := #32;
  90.           Inc(IndxOut);
  91.           end;
  92.         end;
  93.       #0..#31:
  94.         begin
  95.         OutStr[IndxOut] := #32;
  96.         Inc(IndxOut);
  97.         end;
  98.       else
  99.         begin
  100.         OutStr[IndxOut] := InStr[IndxIn];
  101.         Inc(IndxOut);
  102.         end;
  103.     end;
  104.   OutStr[IndxOut] := #0;
  105.   ExpandTabs := TRUE;
  106. end;
  107.  
  108. function CheckCC(InStr,OutStr:PChar):Boolean;
  109. var
  110.   IndxIn,IndxOut:Integer;
  111. begin
  112.   IndxIn := 0;IndxOut:= 0;
  113.   For IndxIn := 0 to (StrLen(InStr) -1) do
  114.     case InStr[IndxIn] of
  115.       #9:                             {retain tabs}
  116.         begin
  117.         OutStr[IndxOut] := #9;
  118.         Inc(IndxOut);
  119.         end;
  120.       #0..#31:
  121.         begin
  122.         OutStr[IndxOut] := #32;
  123.         Inc(IndxOut);
  124.         end;
  125.       else
  126.         begin
  127.         OutStr[IndxOut] := InStr[IndxIn];
  128.         Inc(IndxOut);
  129.         end;
  130.     end;
  131.   OutStr[IndxOut] := #0;
  132.   CheckCC := TRUE;
  133. end;
  134.  
  135. function SRectangle(PaintDC,X1,Y1,X2,Y2,LineWidth,State:Integer):Boolean;
  136. var
  137.   MemDC:HDc;
  138.   ThePen,Pen1,Pen2,OldPen:HPen;
  139.   TheBrush,OldBrush:HBrush;
  140.   OldBitMap:HBitMap;
  141.   LPts,RPts:Array[0..2] of TPoint;
  142.   X,Y,W,H:Integer;
  143.   PW,Ofs:Integer;
  144.   DBU:LongRec;
  145. begin
  146.   LongInt(DBU) := GetDialogBaseUnits;               
  147.   PW := Ofs;
  148.   Ofs := 1;            
  149.   TheBrush := GetStockObject(LtGray_Brush);
  150.   ThePen := CreatePen(ps_Solid,1,$00000000);
  151.   OldPen := SelectObject(PaintDC,ThePen);
  152.   OldBrush := SelectObject(PaintDC,TheBrush);
  153.   Rectangle(PaintDC,X1,Y1,X2,Y2);    {Draw gray box,black border}
  154.   SelectObject(PaintDC,OldBrush);
  155.   SelectObject(PaintDC,OldPen);
  156.   DeleteObject(ThePen);
  157.  
  158.   LPts[0].x := X1+Ofs; LPts[0].y := Y2-Ofs;
  159.   LPts[1].x := X1+Ofs; LPts[1].y := Y1-Ofs;
  160.   LPts[2].x := X2-Ofs; LPts[2].y := Y1-Ofs;
  161.   RPts[0].x := X1+Ofs; RPts[0].y := Y2-Ofs;
  162.   RPts[1].x := X2-Ofs; RPts[1].y := Y2-Ofs;
  163.   RPts[2].x := X2-Ofs; RPts[2].y := Y1-Ofs;
  164.   if State = sr_Raised then
  165.     begin
  166.     Pen1 := CreatePen(ps_Solid,LineWidth,$00FFFFFF);
  167.     Pen2 := CreatePen(ps_Solid,LineWidth,$00808080);
  168.     end
  169.   else
  170.     begin
  171.     Pen1 := CreatePen(ps_Solid,LineWidth,$00000000);
  172.     Pen2 := CreatePen(ps_Solid,LineWidth,$00FFFFFF);
  173.     end;
  174.  
  175.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  176.   PolyLine(PaintDC,LPts,3);
  177.   SelectObject(PaintDC,Pen2);
  178.   DeleteObject(Pen1);
  179.  
  180.   PolyLine(PaintDC,RPts,3);
  181.   SelectObject(PaintDC,OldPen);
  182.   DeleteObject(Pen2);
  183.  
  184. end;
  185.  
  186. end.
  187.